home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / peek173c.zip / RSB2PEEK.MRG < prev   
Text File  |  1992-04-17  |  14KB  |  241 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB2.BAS to produce RBBSSUB2.NEW
  3. * RBBSSUB2.BAS:  Date 9-5-1991  Size 138506 bytes
  4. * ------------[ Created 04-17-1992 ]------------
  5.  
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB2.BAS 17.3C, Copyright 1986 - 91 by D. Thomas Mack'
  8. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB2.BAS
  10. '  First Released .....: February 11, 1990
  11. '  Subsequent Releases.: August 26, 1990; October 28, 1990; Sept 1, 1991
  12. '  Copyright ..........: 1986 - 1991
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  AnswerIt        200  Answer the telephone when it rings
  23. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  24. '  BadChar         455  Check user name for invalid characters
  25. '  BadName       20235  Check for system crash attempt with bad file name
  26. '  BankTime       5497  Let Caller change Banked Time                ' RM040101
  27. '  Baud450        5507  Allow 300 baud callers to bump up to 450 baud
  28. '  CheckRatio    20096  Test upload/download ratio
  29. '  CheckMacro     1242  Checks for macro and processes
  30. '  CopyRight        97  Display RBBS-PC's copyright notice
  31. '  DefaultU       9600  Write out the user's defaults
  32. '  DenyAccess     1386  Downgrade security so access denied
  33. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  34. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  35. '  EditALine      2618  Edits a single line
  36. '  EditDef         120  Edit configuration parameters
  37. '  FileNameCheck 20240  Matches file name to a prefix & extension
  38. '  GetArc        20140  Handle request for verbose listing
  39. '  GetCommand      101  Get RBBS-PC's node id from command line
  40. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  41. '  GoIdle           90  Release resources when waiting for keyboard input
  42. '  KillMsg        3952  Delete old or unnecessary messages
  43. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  44. '  LineEdit       3700  Edit a line while minimizing string space consumption
  45. '  LogError      13660  Log error message to CALLERS file
  46. '  LPrnt          1480  Subroutine to write to local display
  47. '  Macro          1320  Check/execute Macro
  48. '  MLInit            8  Handle MultiLink initialization/de-initialization
  49. '  MsgProt        2055  Sets protection for a message
  50. '  MessageTo      2018  Sets who a message is to
  51. '  PageLen        5200  Change page length
  52. '  ParseIt        1637  Parses a string
  53. '  PassWrd         660  Verify user & message passwords
  54. '  PopCmdStack    1650  Get user input, 1st checking command stack
  55. '  PScrn          1483  Print to display
  56. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  57. '  QuickPeek     20340  Easy find user to send message to            ' PEEK173C
  58. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  59. '  QuickTPut1     1478  Outputs short string following by CR LF
  60. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  61. '  RecoverMsg    10410  Recover a deleted message
  62. '  RemNonAlf      5100  Removes non-alpha characters from a string
  63. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  64. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  65. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  66. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  67. '  SetThread      4554  Set up request for threading thru messages
  68. '  SkipLine       1485  Write a # of blank lines to the communications port
  69. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  70. '  SecViolation   1380  Process a security violation
  71. '  SysMenu         112  Displays sysop menu/status
  72. '  SysopChat      4773  Sysop and caller chat
  73. '  TestRel         336  Tests for Reliable connect
  74. '  TGet           1498  Read a line from the communications port
  75. '  TPut           1396  Write a line to the communications port
  76. '  Trim            105  Strip leading and trailing blanks from a string
  77. '  TrimTrail       107  Strip off specified string off end of another string
  78. '  UntilRight    12878  Ask a question until user says answer is right
  79. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  80. '  VarInit         109  Initialize system variables
  81. '  ViewHelp       1330  Processes help command
  82. '  WhoCheck       2250  Checks whether a user exists in user file
  83. '  WhosOn         9801  Report status of each node - who's on
  84. '  WordInFile    10976  Find a whole word within a file/menu
  85.  
  86. 2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to'
  87. ' $PAGE
  88. '
  89. '  NAME    -- MessageTo
  90. '
  91. '  INPUTS  --     PARAMETER                    MEANING
  92. '              HighestUserRecord
  93. '
  94. '  OUTPUTS --  MsgTo$              Who message is to
  95. '              RcvrRecNum         User record # of who to
  96. '
  97. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  98. '
  99.      SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
  100.      Temp$ = MsgFrom$
  101.      CALL Trim (Temp$)
  102. 2020 IF MsgTo$ <> "" THEN _
  103.         GOTO 2032
  104.      ZOutTxt$ = "To: [A]ll,S)ysop or Name (2 Char. Min.)"            ' TC090101/PEEK173C
  105.      CALL SkipLine (1)                                               ' TC090101/PEEK173C
  106.      ZParseOff = ZTrue
  107.      GOSUB 2033
  108.      IF LEN(ZUserIn$) > 30 THEN _
  109.         CALL QuickTPut1 ("30 Chars Max.") : _                        ' TC090101
  110.         GOTO 2020
  111.      IF LEFT$(ZUserIn$,1) = " " THEN _                               ' PEEK173C
  112.         CALL SkipLine (1) : _                                        ' PEEK173C
  113.         CALL QuickTPut1 ("Name can't begin with a SPACE") : _        ' PEEK173C
  114.         CALL SkipLine (1) : _                                        ' PEEK173C
  115.         GOTO 2020                                                    ' PEEK173C
  116. 2030 Found = ZTrue
  117.      IF ZWasQ = 0 THEN _
  118.         MsgTo$ = "ALL" : _                                           ' PEEK173C
  119.         GOTO 2032 _                                                  ' PEEK173C
  120.      ELSE ZWasDF$ = ZUserIn$(ZAnsIndex) : _                          ' PEEK173C
  121.         CALL AllCaps (ZWasDF$) : _                                   ' PEEK173C
  122.         ZUserIn$(ZAnsIndex) = ZWasDF$ : _                            ' PEEK173C
  123.         MsgTo$ = ZWasDF$ : _                                         ' PEEK173C
  124.         IF ZWasDF$ = "A" THEN _                                      ' PEEK173C
  125.              MsgTo$ = "ALL" _                                        ' PEEK173C
  126.         ELSE IF ZWasDF$ = "S" THEN _                                 ' PEEK173C
  127.              MsgTo$ = "SYSOP" _                                      ' PEEK173C
  128.         ELSE MsgTo$ = ZWasDF$                                        ' PEEK173C
  129.      GOTO 2032                                                       ' PEEK173C
  130. 2032 RcvrRecNum = 0                                                  ' PEEK173C
  131.      IF MsgTo$ <> "ALL" THEN _                                       ' PEEK173C
  132.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  133.            ZWasDF = INSTR(MsgTo$+" @"," @") : _                      ' KG052201
  134.            TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _               ' KG052201
  135.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  136.            CALL QuickPeek (ZUserIn$(ZAnsIndex),MsgTo$,Found) : _     ' PEEK173C
  137. '          CALL AliasChk (MsgTo$,Found,UserNumFound) : _             ' MPLALIAS  uncomment the beginning of the line if you are using the MPLALIAS merge
  138.            IF NOT Found THEN _
  139.               CALL QuickTPut1 (MsgTo$ + " not active user") : _      ' PEEK173C
  140.               ZLastIndex = 0 : _
  141.               RcvrRecNum = 0 : _                                     ' KG060901
  142.               IF NOT ZReply THEN _
  143.                  ZOutTxt$ = "[R]e-Enter Name, Q)uit, C)ontinue" : _  ' TC090101
  144.                  ZTurboKey = -ZTurboKeyUser : _
  145.                  ZLastIndex = 0 : _
  146.                  GOSUB 2033 : _
  147.                  ZWasZ$ = ZUserIn$(1) : _
  148.                  CALL AllCaps (ZWasZ$) : _
  149.                  IF ZWasZ$ <> "C" THEN _
  150.                     MsgTo$ = "" : _
  151.                     IF ZWasZ$ <> "Q" THEN _
  152.                        GOTO 2020
  153.      IF MsgTo$ = Temp$ THEN _
  154.         ZOutTxt$ = "Message is To AND From You. Really Do This (Y,[N])" : _ ' TC090101
  155.         ZLastIndex = 0 : _
  156.         GOSUB 2033 : _
  157.         IF NOT ZYes THEN _
  158.            MsgTo$ = ""
  159.      EXIT SUB
  160. 2033 CALL PopCmdStack
  161.      IF ZSubParm < 0 THEN _
  162.         EXIT SUB
  163.      RETURN
  164.      END SUB
  165.  
  166. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  167. ' $PAGE
  168. '
  169. '  NAME    -- FileNameCheck
  170. '
  171. '  INPUTS  --     PARAMETER                    MEANING
  172. '               CheckThis$           Name of file to check
  173. '               Pref2$               Prefix to match against
  174. '               Ext2$                Extension to match against
  175. '
  176. '  OUTPUTS  -- ZOK                    1 if got match
  177. '
  178. '  PURPOSE -- Checks for match on both prefix and extension of a file
  179. '             name.   Used to catch match on system files not to be
  180. '             downloaded.
  181. '
  182.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  183.       IF ZOK > 0 THEN _
  184.          EXIT SUB
  185.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  186.       IF Pref1$ = Pref2$ THEN _
  187.          IF Ext1$ = Ext2$ THEN _
  188.             ZOK = 1
  189.       END SUB
  190. 20340 ' $SUBTITLE: 'QuickPeek - Easy find user to send message to'   ' DD030692
  191. ' $PAGE                                                              ' PEEK173C
  192. '                                                                    ' PEEK173C
  193. '  NAME    -- QuickPeek                                              ' PEEK173C
  194. '                                                                    ' PEEK173C
  195. '  INPUTS  --     PARAMETER                    MEANING               ' PEEK173C
  196. '                                                                    ' PEEK173C
  197. '  OUTPUTS --     ZUserIn$                Search String User Input   ' PEEK173C
  198. '                 MsgTo$                  Who Message is To          ' PEEK173C
  199. '  PURPOSE -- Save User keystrokes when looking for message addressee' PEEK173C
  200. '                                                                    ' PEEK173C
  201.       SUB QuickPeek (ZUserIn$,MsgTo$,WhoFound)  Static               ' PEEK173C
  202.       IF WhoFound = ZTrue THEN EXIT SUB                              ' PEEK173C
  203.       ZLastDateTimeOnSave$ = ZLastDateTimeOn$                        ' PEEK173C
  204.       UserInName$ = ZUserIn$                                         ' PEEK173C
  205.       WhichUser = 1                                                  ' PEEK173C
  206.       CALL OpenUser (ZHighestUserRecord)                             ' PEEK173C
  207.       WHILE NOT EOF(5)                                               ' PEEK173C
  208.          GET #5, WhichUser                                           ' PEEK173C
  209.          TempMsgTo$ = ZUserName$                                     ' PEEK173C
  210.          CALL TRIM (TempMsgTo$)                                      ' PEEK173C
  211.          IF UserInName$ = TempMsgTo$ THEN EXIT SUB                   ' PEEK173C
  212.          IF INSTR(TempMsgTo$,UserInName$) > 0 THEN                   ' PEEK173C
  213.          ZSubParm = 1                                                ' PEEK173C
  214.          ZOutTxt$ = "Send to: " + TempMsgTo$ + " (Y)es, [N])o, A)bort)" ' PEEK173C
  215.          ZTurboKey = -ZTurboKeyUser                                  ' PEEK173C
  216.          CALL PopCmdStack                                            ' PEEK173C
  217.          IF ZSubParm = -1 THEN _                                     ' PEEK173C
  218.             EXIT SUB                                                 ' PEEK173C
  219.          ZWasZ$ = ZUserIn$(1)                                        ' PEEK173C
  220.          CALL AllCaps (ZWasZ$)                                       ' PEEK173C
  221.          IF ZWasZ$ = "A" THEN _                                      ' PEEK173C
  222.             EXIT SUB                                                 ' PEEK173C
  223. '        IF ZWasQ = 0 THEN _                                         ' PEEK173C
  224. '           ZYes = ZTrue                                             ' PEEK173C
  225. '        CALL AllCaps (ZUserIn$)                                     ' PEEK173C
  226.          IF ZWasZ$ = "Y" THEN                                                ' PEEK173C
  227.             MsgTo$ = TempMsgTo$                                      ' PEEK173C
  228.             ZUserIn$ = TempMsgTo$                                    ' PEEK173C
  229.             WhoFound = ZTrue                                         ' PEEK173C
  230.             ZLastDateTimeOn$ = ZLastDateTimeOnSave$                  ' PEEK173C
  231.             EXIT SUB                                                 ' PEEK173C
  232.          ELSE                                                        ' PEEK173C
  233.             WhichUser=WhichUser+1                                    ' PEEK173C
  234.          END IF                                                      ' PEEK173C
  235.          ELSE                                                        ' PEEK173C
  236.             WhichUser=WhichUser+1                                    ' PEEK173C
  237.          END IF                                                      ' PEEK173C
  238.       WEND                                                           ' PEEK173C
  239.       ZLastDateTimeOn$ = ZLastDateTimeOnSave$                        ' PEEK173C
  240.       END SUB                                                        ' PEEK173C
  241.